home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Sample Code / Snippets / Devices / ledApp / ledApp.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  8.6 KB  |  313 lines  |  [TEXT/MPS ]
  1. PROGRAM ledApp;
  2.  
  3.     { 
  4.       This faceless background task counts to 7 on an extended keyboard's lights.
  5.       The application quits when the user holds down the shift and caps lock
  6.       keys, or when it receives a quit Apple Event.
  7.       
  8.       ledApp installs a Time Manager task which wakes the application every
  9.       500 ms.
  10.       
  11.       June 1991  by Greg Robbins
  12.     }
  13.       
  14.  
  15.     USES
  16.     
  17.         Memtypes, AppleEvents, OSIntf, PackIntf, { Standard Includes }
  18.         GestaltEqu, Timer;
  19.     
  20.     CONST
  21.     
  22.         kSleepVal = MAXLONGINT; { for WaitNextEvent }
  23.         kTimerPrimer = 500; { for PrimeTime, 500 ms }
  24.         
  25.         { keyboard ADB constants }
  26.         kTalkCommand = 8+4;
  27.         kListenCommand = 8;
  28.         kLEDRegister = 2;
  29.         
  30.         kShiftKeyBit = 56;
  31.         kShiftLockBit = 57;
  32.  
  33.     TYPE
  34.  
  35.         ADBregBuffType = PACKED ARRAY[0..8] of BYTE; { data buffer for ADB }
  36.         
  37.         { enhance the time manager record with my A5 so the 
  38.           task can access global variables }
  39.         enhTMTaskRec = RECORD 
  40.                             theTMTask: TMTask;
  41.                             myA5: LONGINT
  42.                         END;
  43.         enhTMTaskPtr = ^enhTMTaskRec;
  44.         
  45.     VAR
  46.  
  47.         myEvtRec: EventRecord;
  48.         timeMgrVers, aePresent: LONGINT; { Gestalt values }
  49.         quitFlag, nullEvtFlag: BOOLEAN;
  50.         ledPattern: BYTE;
  51.         
  52.         myTMTaskRec: enhTMTaskRec;
  53.         timeTaskFlag: BOOLEAN;
  54.         
  55.         myNMRec: NMRec; { notification manager record }
  56.         notificationCompleteFlag: BOOLEAN;
  57.         
  58.         anOSErr: OSErr;
  59.         myPSN: ProcessSerialNumber;
  60.  
  61.         myKeyMap: KeyMap;
  62.     
  63.     
  64.     FUNCTION getTMInfo: enhTMTaskPtr;
  65.         INLINE $2E89; { put A1 on stack }
  66.     
  67.     PROCEDURE myTimeTask;
  68.     { this routine is executed when the primed time manager task comes due }
  69.         VAR
  70.             recPtr: enhTMTaskPtr;
  71.             oldA5: LONGINT;
  72.             anOSErr: LONGINT;
  73.             
  74.         BEGIN
  75.             recPtr := getTMInfo; { get pointer to record for this task }
  76.             
  77.             oldA5 := SetA5(recPtr^.myA5); { we want globals }
  78.                         
  79.             { flag that time is up and wake the app }
  80.             timeTaskFlag := TRUE; 
  81.             anOSErr := WakeUpProcess(myPSN);
  82.             
  83.             { make this task periodic }
  84.             PrimeTime(QElemPtr(recPtr), kTimerPrimer);
  85.             
  86.             { now back to our previously scheduled A5 world }
  87.             oldA5 := SetA5(oldA5); 
  88.         END;
  89.         
  90.     PROCEDURE myNMResponseProc(myNMRecPtr: NMRecPtr);
  91.     { flag that notification has been executed }
  92.     VAR
  93.         oldA5: LONGINT;
  94.     BEGIN
  95.         oldA5 := SetA5(myNMRecPtr^.nmRefCon);
  96.         notificationCompleteFlag := TRUE;
  97.         oldA5 := SetA5(oldA5);
  98.         { would have been simpler just to pass the flag address rather than A5 }
  99.     END;
  100.     
  101.     
  102.     PROCEDURE DoNotification(nmString: Str255);
  103.     { put up notification alert }
  104.     BEGIN
  105.         { set up notification manager record for alert notification }
  106.         myNMRec.qType := ORD(nmType);
  107.         myNMRec.nmMark := 0;
  108.         myNMRec.nmIcon := NIL;
  109.         myNMRec.nmSound := Handle(-1);
  110.         myNMRec.nmStr := @nmString;
  111.         myNMRec.nmResp := @myNMResponseProc;
  112.         myNMRec.nmRefCon := SetCurrentA5;
  113.         
  114.         notificationCompleteFlag := FALSE;
  115.         
  116.         anOSErr := NMInstall(@myNMRec);
  117.         
  118.         REPEAT
  119.             nullEvtFlag := EventAvail(everyEvent, myEvtRec); { to allow notification }
  120.         UNTIL (anOSErr <> 0) OR (notificationCompleteFlag);
  121.         
  122.         anOSErr := NMRemove(@myNMRec);
  123.     END;
  124.             
  125.     PROCEDURE DropDead(sTemp: Str255);
  126.     { unresolvable failure }
  127.     
  128.         BEGIN
  129.             quitFlag := TRUE;
  130.             DoNotification(sTemp);
  131.         END;
  132.     
  133.     FUNCTION GetA2: LONGINT;
  134.         INLINE $2E8A; { put A2 on stack }
  135.         
  136.     PROCEDURE CompADBOp;
  137.     { completion routine for ADB talks and listens }
  138.         TYPE
  139.             boolPtr = ^BOOLEAN;
  140.         VAR
  141.             completionFlagPtr: boolPtr;
  142.         BEGIN
  143.             { set flag to indicate completion routine has run; A2 points to the flag }
  144.             completionFlagPtr := boolPtr(GetA2); 
  145.             completionFlagPtr^ := TRUE;
  146.         END;
  147.     
  148.     PROCEDURE DoSetLEDs(ledPat: BYTE);
  149.     { set the leds to the given pattern }
  150.         TYPE
  151.             ADBregBuffType = PACKED ARRAY[0..8] of BYTE;
  152.  
  153.         VAR
  154.             retCode:    OSErr;
  155.             i: INTEGER;                                    { index through ADB devices }
  156.             numADBs: INTEGER;                            { total number of ADB devices }
  157.             anADBDB: array[1..16] of ADBDataBlock;        { data block for each device }
  158.             anADBadd: array[1..16] of ADBAddress;        { address of each device }
  159.             regBuff: ADBregBuffType;                    { buffer for ADBOp commands }
  160.             oldReg: BYTE;
  161.             completionFlag: BOOLEAN;
  162.  
  163.         BEGIN
  164.             numADBs := CountADBs;
  165.  
  166.             FOR i:=1 to numADBs DO
  167.                 BEGIN
  168.                     { get an address for an ADB device }
  169.                     anADBadd[i] := GetIndADB(anADBDB[i], i);
  170.                     
  171.                     { a keyboard has an original address of 2, but the actual ADB address
  172.                       may change if there is a conflict; a U.S. extended keyboard has a
  173.                       device type ("handler ID") of 2, but unfortunately some other ADB devices
  174.                       also do }
  175.                     IF (anADBDB[i].origADBAddr = 2) AND (anADBDB[i].devType = 2) THEN { ext keyboard }
  176.                         BEGIN
  177.                             regBuff[0] := BYTE(2); { initial data buffer length }
  178.  
  179.                             { talk }
  180.                             completionFlag := FALSE;
  181.                             retCode := ADBOp(@completionFlag, @CompADBOp, @regBuff,
  182.                                  kTalkCommand + kLEDRegister + 16 * anADBadd[i]);
  183.                             
  184.                             IF retCode <> noErr THEN
  185.                                 EXIT(DoSetLEDs);
  186.                             
  187.                             { do nothing until completion routine has run }
  188.                             REPEAT
  189.                                 ;
  190.                             UNTIL completionFlag;
  191.                             
  192.                             { extended keyboard has a word of data, LEDs are low 3 bits }
  193.                             oldReg := regBuff[2];
  194.                             
  195.                             { set the specified bits; note that a clear bit indicates an lit LED }
  196.                             regBuff[2] := BOR(BAND(oldReg, 255-7), 7 - LedPat);
  197.  
  198.                             { listen }
  199.                             completionFlag := FALSE;                        
  200.                             retCode := ADBOp(@completionFlag, @CompADBOp, @regBuff, 
  201.                                 kListenCommand + kLEDRegister + 16 * anADBadd[i]);
  202.  
  203.                             { do nothing until completion routine has run }
  204.                             REPEAT
  205.                                 ;
  206.                             UNTIL (retCode <> noErr) OR (completionFlag);
  207.                             
  208.                         END; { if }
  209.                 END; { for }
  210.         END; { DoSetLEDs }
  211.  
  212.     PROCEDURE DoHighLevel(anAERec: EventRecord);
  213.     { handle high-level events }
  214.         BEGIN
  215.             IF AEProcessAppleEvent(anAERec) <> noErr THEN
  216.                 DropDead('ledApp cannot run: cannot process Apple Events');
  217.         END;
  218.     
  219.     FUNCTION DoAEOpen(theAEvent: AppleEvent; reply: AppleEvent; refcon: LONGINT): OSErr;
  220.         BEGIN
  221.             DoAEOpen := noErr;
  222.         END; { Do AEOpen }
  223.         
  224.     FUNCTION DoAEOpenDoc(theAEvent: AppleEvent; reply: AppleEvent; refcon: LONGINT): OSErr;
  225.         BEGIN
  226.             DoAEOpenDoc := errAEEventNotHandled;
  227.         END; { DoAEOpenDoc }
  228.  
  229.     FUNCTION DoAEPrintDoc(theAEvent: AppleEvent; reply: AppleEvent; refcon: LONGINT): OSErr;
  230.         BEGIN
  231.             DoAEPrintDoc := errAEEventNotHandled;
  232.         END; { DoAEPrintDoc }
  233.         
  234.     FUNCTION DoAEQuit(theAEvent: AppleEvent; reply: AppleEvent; refcon: LONGINT): OSErr;
  235.         BEGIN
  236.             quitFlag := TRUE;
  237.             DoAEQuit := noErr;
  238.         END; { DoAEQuit }
  239.         
  240.     PROCEDURE InitStuff;
  241.     { Apple Events handler installation and other initialization}
  242.         BEGIN
  243.             IF Gestalt(gestaltAppleEventsAttr, aePresent) = noErr THEN
  244.                 BEGIN
  245.                     IF AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @DoAEOpen, 0, FALSE) <> noErr THEN
  246.                         DropDead('ledApp cannot run: cannot install open application event');
  247.                     IF AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @DoAEOpenDoc, 0, FALSE) <> noErr THEN
  248.                         DropDead('ledApp cannot run: cannot install open document event');
  249.                     IF AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments, @DoAEPrintDoc, 0, FALSE) <> noErr THEN
  250.                         DropDead('ledApp cannot run: cannot install print document event');
  251.                     IF AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @DoAEQuit, 0, FALSE) <> noErr THEN
  252.                         DropDead('ledApp cannot run: cannot install quit event');
  253.                 END
  254.             ELSE DropDead('ledApp cannot run: Apple Events not present');
  255.             
  256.             IF Gestalt(gestaltTimeMgrVersion, timeMgrVers) <> noErr THEN
  257.                 DropDead('ledApp cannot run: time manager problem');
  258.             IF timeMgrVers = 1 THEN { can't use standard time manager for re-priming }
  259.                 DropDead('ledApp cannot run: wrong time manager version');
  260.             
  261.         END; { InitStuff }
  262.     
  263.     BEGIN                                                          {main}
  264.  
  265.         quitFlag := FALSE;
  266.         timeTaskFlag := FALSE;
  267.         
  268.         InitStuff;
  269.         anOSErr := GetCurrentProcess(myPSN);
  270.         
  271.         { turn LEDs off }
  272.         DoSetLEDs(0);
  273.  
  274.         { set up task record for time manager }
  275.         myTMTaskRec.theTMTask.tmAddr := @myTimeTask;
  276.         myTMTaskRec.theTMTask.tmCount := 0;
  277.         myTMTaskRec.myA5 := SetCurrentA5;
  278.         
  279.         InsTime(@myTMTaskRec);
  280.         
  281.         { activate time manager }
  282.         PrimeTime(@myTMTaskRec, kTimerPrimer);
  283.         
  284.         { main event loop; quitFlag may be set already }
  285.         WHILE NOT(quitFlag) DO
  286.             BEGIN
  287.                 IF timeTaskFlag THEN 
  288.                     { time manager task has run }
  289.                     BEGIN
  290.                         ledPattern := (ledPattern + 1) MOD 8;
  291.                         DoSetLEDs(ledPattern);
  292.                         timeTaskFlag := FALSE;
  293.                     END;
  294.                     
  295.                 { sleep until awoken by the time manager task or by an Apple Event }
  296.                 nullEvtFlag := WaitNextEvent(highLevelEventMask, myEvtRec, kSleepVal, NIL);
  297.  
  298.                 IF myEvtRec.what = kHighLevelEvent THEN
  299.                     DoHighLevel(myEvtRec);
  300.  
  301.                 { quit if shift and caps lock are down }
  302.                 GetKeys(myKeyMap);                
  303.                 IF myKeyMap[kShiftKeyBit] AND myKeyMap[kShiftLockBit] THEN 
  304.                     quitFlag := TRUE;
  305.             END;    
  306.         
  307.         { make sure time manager task isn't executed after app is gone }
  308.         RmvTime(@myTMTaskRec);
  309.         
  310.         DoSetLEDs(0); { turn off leds }
  311.  
  312.     END.
  313.